The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
Changes 022
MANIFEST 03
META.yml 22
inc/Module/Install/AutoInstall.pm 11
inc/Module/Install/Base.pm 11
inc/Module/Install/Can.pm 11
inc/Module/Install/Fetch.pm 11
inc/Module/Install/Include.pm 11
inc/Module/Install/Makefile.pm 57
inc/Module/Install/Metadata.pm 310
inc/Module/Install/Scripts.pm 11
inc/Module/Install/Win32.pm 11
inc/Module/Install/WriteAll.pm 11
inc/Module/Install.pm 33
lib/Catalyst/Component.pm 28
lib/Catalyst/Controller.pm 420
lib/Catalyst/Engine/CGI.pm 06
lib/Catalyst/Engine.pm 112
lib/Catalyst/Runtime.pm 11
lib/Catalyst/Script/Create.pm 22
lib/Catalyst/Script/Server.pm 11
lib/Catalyst.pm 2019
t/aggregate/unit_core_ctx_attr.t 030
t/aggregate/unit_core_engine_cgi-prepare_path.t 213
t/lib/TestApp/Controller/Moose/NoAttributes.pm 016
t/lib/TestApp.pm 029
t/unit_core_methodattributes_method_metaclass_on_subclasses.t 030
27 files changed (This is a version diff) 54242
@@ -1,5 +1,27 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.80025 2010-07-29 01:50:00
+
+ New features:
+  - An 'action_class' method has been added to Catalyst::Controller to
+    allow controller base classes, roles or traits
+    (e.g. Catalyst::Controller::ActionRole) to more easily override
+    the default action creation.
+
+ Bug fixes:
+  - Fix the --mech and --mechanize options to the myapp_create.pl script
+    to operate correctly by fixing the options passed down into the script.
+  - Fix controllers with no method attributes (where the action definitions
+    are entirely contained in config). RT#58057
+  - Fix running as a CGI under IIS at non-root locations.
+
+ Documentation:
+  - Fix missing - in the docs when describing the --mechanize option at one
+    point.
+  - Explained the common practice how to access the component's config
+    values.
+  - Fixed typo in Catalyst/Script/Server.pm (RT #58474)
+
 5.80024 2010-05-15 11:55:44
 
   Bug fixes:
@@ -137,6 +137,7 @@ t/aggregate/unit_core_component_generating.t
 t/aggregate/unit_core_component_layers.t
 t/aggregate/unit_core_component_loading.t
 t/aggregate/unit_core_component_mro.t
+t/aggregate/unit_core_ctx_attr.t
 t/aggregate/unit_core_engine_cgi-prepare_path.t
 t/aggregate/unit_core_engine_fixenv-iis6.t
 t/aggregate/unit_core_engine_fixenv-lighttpd.t
@@ -268,6 +269,7 @@ t/lib/TestApp/Controller/Index.pm
 t/lib/TestApp/Controller/Keyword.pm
 t/lib/TestApp/Controller/Moose.pm
 t/lib/TestApp/Controller/Moose/MethodModifiers.pm
+t/lib/TestApp/Controller/Moose/NoAttributes.pm
 t/lib/TestApp/Controller/Priorities.pm
 t/lib/TestApp/Controller/Priorities/loc_vs_index.pm
 t/lib/TestApp/Controller/Priorities/locre_vs_index.pm
@@ -348,6 +350,7 @@ t/optional_threads.t
 t/plugin_new_method_backcompat.t
 t/something/Makefile.PL
 t/something/script/foo/bar/for_dist
+t/unit_core_methodattributes_method_metaclass_on_subclasses.t
 t/unit_stats.t
 t/unit_utils_load_class.t
 t/unit_utils_subdir.t
@@ -10,7 +10,7 @@ build_requires:
 configure_requires:
   ExtUtils::MakeMaker: 6.42
 distribution_type: module
-generated_by: 'Module::Install version 0.97'
+generated_by: 'Module::Install version 0.99'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -68,4 +68,4 @@ resources:
   homepage: http://dev.catalyst.perl.org/
   license: http://dev.perl.org/licenses/
   repository: http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/
-version: 5.80024
+version: 5.80025
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -4,7 +4,7 @@ package Module::Install::Base;
 use strict 'vars';
 use vars qw{$VERSION};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 }
 
 # Suspend handler for "redefined" warnings
@@ -9,7 +9,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -4,10 +4,11 @@ package Module::Install::Makefile;
 use strict 'vars';
 use ExtUtils::MakeMaker   ();
 use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -364,9 +365,9 @@ sub fix_up_makefile {
 		. ($self->postamble || '');
 
 	local *MAKEFILE;
-	open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+	open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+	eval { flock MAKEFILE, LOCK_EX };
 	my $makefile = do { local $/; <MAKEFILE> };
-	close MAKEFILE or die $!;
 
 	$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
 	$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -386,7 +387,8 @@ sub fix_up_makefile {
 	# XXX - This is currently unused; not sure if it breaks other MM-users
 	# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
 
-	open  MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+	seek MAKEFILE, 0, SEEK_SET;
+	truncate MAKEFILE, 0;
 	print MAKEFILE  "$preamble$makefile$postamble" or die $!;
 	close MAKEFILE  or die $!;
 
@@ -410,4 +412,4 @@ sub postamble {
 
 __END__
 
-#line 539
+#line 541
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -616,8 +616,15 @@ sub _perl_version {
 	return $v;
 }
 
-
-
+sub add_metadata {
+    my $self = shift;
+    my %hash = @_;
+    for my $key (keys %hash) {
+        warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+             "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+        $self->{values}->{$key} = $hash{$key};
+    }
+}
 
 
 ######################################################################
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.97';;
+	$VERSION = '0.99';
 	@ISA     = qw{Module::Install::Base};
 	$ISCORE  = 1;
 }
@@ -22,7 +22,6 @@ use strict 'vars';
 use Cwd        ();
 use File::Find ();
 use File::Path ();
-use FindBin;
 
 use vars qw{$VERSION $MAIN};
 BEGIN {
@@ -32,7 +31,7 @@ BEGIN {
 	# This is not enforced yet, but will be some time in the next few
 	# releases once we can make sure it won't clash with custom
 	# Module::Install extensions.
-	$VERSION = '0.97';
+	$VERSION = '0.99';
 
 	# Storage for the pseudo-singleton
 	$MAIN    = undef;
@@ -231,7 +230,8 @@ sub preload {
 sub new {
 	my ($class, %args) = @_;
 
-	FindBin->again;
+    delete $INC{'FindBin.pm'};
+    require FindBin;
 
 	# ignore the prefix on extension modules built from top level.
 	my $base_path = Cwd::abs_path($FindBin::Bin);
@@ -170,7 +170,7 @@ to be stored in the application's component hash.
 
 C<< my $component_instance = $component->COMPONENT($app, $arguments); >>
 
-If this method is present (as it is on all Catalyst::Component subclasses,
+If this method is present (as it is on all Catalyst::Component subclasses),
 it is called by Catalyst during setup_components with the application class
 as $app and any config entry on the application for this component (for example,
 in the case of MyApp::Controller::Foo this would be
@@ -185,7 +185,7 @@ something like this:
 
   sub COMPONENT {
       my ($class, $app, $args) = @_;
-      $args = $self->merge_config_hashes($self->config, $args);
+      $args = $class->merge_config_hashes($class->config, $args);
       return $class->new($app, $args);
   }
 
@@ -200,6 +200,12 @@ key value pair, or you can specify a hashref. In either case the keys
 will be merged with any existing config settings. Each component in
 a Catalyst application has its own config hash.
 
+The component's config hash is merged with any config entry on the
+application for this component and passed to C<new()> (as mentioned
+above at L</COMPONENT>). The common practice to access the merged
+config is to use a Moose attribute for each config entry on the
+receiving component.
+
 =head2 $c->process()
 
 This is the default method called on a Catalyst component in the dispatcher.
@@ -225,7 +225,9 @@ sub register_action_methods {
 
     foreach my $method (@methods) {
         my $name = $method->name;
-        my $attributes = $method->attributes;
+        # Horrible hack! All method metaclasses should have an attributes
+        # method, core Moose bug - see r13354.
+        my $attributes = $method->can('attributes') ? $method->attributes : [];
         my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
         if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
             $c->log->debug( 'Bad action definition "'
@@ -248,16 +250,25 @@ sub register_action_methods {
     }
 }
 
-sub create_action {
+sub action_class {
     my $self = shift;
     my %args = @_;
 
     my $class = (exists $args{attributes}{ActionClass}
-                    ? $args{attributes}{ActionClass}[0]
-                    : $self->_action_class);
+        ? $args{attributes}{ActionClass}[0]
+        : $self->_action_class);
+
     Class::MOP::load_class($class);
+    return $class;
+}
+
+sub create_action {
+    my $self = shift;
+    my %args = @_;
 
+    my $class = $self->action_class(%args);
     my $action_args = $self->config->{action_args};
+
     my %extra_args = (
         %{ $action_args->{'*'}           || {} },
         %{ $action_args->{ $args{name} } || {} },
@@ -529,6 +540,11 @@ action methods for this package.
 Creates action objects for a set of action methods using C< create_action >,
 and registers them with the dispatcher.
 
+=head2 $self->action_class(%args)
+
+Used when a controller is creating an action to determine the correct base
+action class to use.
+
 =head2 $self->create_action(%args)
 
 Called with a hash of data to be use for construction of a new
@@ -154,6 +154,12 @@ sub prepare_path {
     my $scheme = $c->request->secure ? 'https' : 'http';
     my $host      = $ENV{HTTP_HOST}   || $ENV{SERVER_NAME};
     my $port      = $ENV{SERVER_PORT} || 80;
+
+    # fix up for IIS
+    if ($ENV{SERVER_SOFTWARE} && $ENV{SERVER_SOFTWARE} =~ m{IIS/[6-9]\.\d}) {
+        $ENV{PATH_INFO} =~ s/^\Q$ENV{SCRIPT_NAME}\E//;
+    }
+
     my $script_name = $ENV{SCRIPT_NAME};
     $script_name =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go if $script_name;
 
@@ -10,6 +10,8 @@ use HTML::Entities;
 use HTTP::Body;
 use HTTP::Headers;
 use URI::QueryParam;
+use Encode ();
+use utf8;
 
 use namespace::clean -except => 'meta';
 
@@ -131,6 +133,14 @@ sub finalize_error {
 
     $c->res->content_type('text/html; charset=utf-8');
     my $name = ref($c)->config->{name} || join(' ', split('::', ref $c));
+    
+    # Prevent Catalyst::Plugin::Unicode::Encoding from running.
+    # This is a little nasty, but it's the best way to be clean whether or
+    # not the user has an encoding plugin.
+
+    if ($c->can('encoding')) {
+      $c->{encoding} = '';
+    }
 
     my ( $title, $error, $infos );
     if ( $c->debug ) {
@@ -279,11 +289,12 @@ sub finalize_error {
 </body>
 </html>
 
-
     # Trick IE. Old versions of IE would display their own error page instead
     # of ours if we'd give it less than 512 bytes.
     $c->res->{body} .= ( ' ' x 512 );
 
+    $c->res->{body} = Encode::encode("UTF-8", $c->res->{body});
+
     # Return 500
     $c->res->status(500);
 }
@@ -7,7 +7,7 @@ BEGIN { require 5.008004; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.80024';
+our $VERSION = '5.80025';
 
 =head1 NAME
 
@@ -46,7 +46,7 @@ sub run {
     Class::MOP::load_class($helper_class);
     my $helper = $helper_class->new( { '.newfiles' => !$self->force, mech => $self->mechanize } );
 
-    $self->_getopt_full_usage unless $helper->mk_component( $self->application_name, @ARGV );
+    $self->_getopt_full_usage unless $helper->mk_component( $self->application_name, @{$self->extra_argv} );
 
 }
 
@@ -68,7 +68,7 @@ Catalyst::Script::Create - Create a new Catalyst Component
  Examples:
    myapp_create.pl controller My::Controller
    myapp_create.pl controller My::Controller BindLex
-   myapp_create.pl -mechanize controller My::Controller
+   myapp_create.pl --mechanize controller My::Controller
    myapp_create.pl view My::View
    myapp_create.pl view MyView TT
    myapp_create.pl view TT TT
@@ -231,7 +231,7 @@ Catalyst::Script::Server - Catalyst test server
                       a restart when modified
                       (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
    --rdir --restart_directory  the directory to search for
-                      modified files, can be set mulitple times
+                      modified files, can be set multiple times
                       (defaults to '[SCRIPT_DIR]/..')
    --sym  --follow_symlinks   follow symlinks in search directories
                       (defaults to false. this is a no-op on Win32)
@@ -79,7 +79,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.80024';
+our $VERSION = '5.80025';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -892,7 +892,7 @@ component is constructed.
 For example:
 
     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
-    MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
+    MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
 
 will mean that C<MyApp::Model::Foo> receives the following data when
 constructed:
@@ -903,6 +903,21 @@ constructed:
         overrides => 'me',
     });
 
+It's common practice to use a Moose attribute
+on the receiving component to access the config value.
+
+    package MyApp::Model::Foo;
+
+    use Moose;
+
+    # this attr will receive 'baz' at construction time
+    has 'bar' => ( 
+        is  => 'rw',
+        isa => 'Str',
+    );
+
+You can then get the value 'baz' by calling $c->model('Foo')->bar
+
 =cut
 
 around config => sub {
@@ -2406,10 +2421,6 @@ sub setup_components {
         # we know M::P::O found a file on disk so this is safe
 
         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
-
-        # Needs to be done as soon as the component is loaded, as loading a sub-component
-        # (next time round the loop) can cause us to get the wrong metaclass..
-        $class->_controller_init_base_classes($component);
     }
 
     for my $component (@comps) {
@@ -2419,7 +2430,6 @@ sub setup_components {
             : $class->expand_component_module( $component, $config );
         for my $component (@expanded_components) {
             next if $comps{$component};
-            $class->_controller_init_base_classes($component); # Also cover inner packages
             $class->components->{ $component } = $class->setup_component($component);
         }
     }
@@ -2472,19 +2482,6 @@ sub expand_component_module {
 
 =cut
 
-# FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
-#         nearest to Catalyst::Controller first, no matter what order stuff happens
-#         to be loaded. There are TODO tests in Moose for this, see
-#         f2391d17574eff81d911b97be15ea51080500003
-sub _controller_init_base_classes {
-    my ($app_class, $component) = @_;
-    return unless $component->isa('Catalyst::Controller');
-    foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
-        Moose::Meta::Class->initialize( $class )
-            unless find_meta($class);
-    }
-}
-
 sub setup_component {
     my( $class, $component ) = @_;
 
@@ -3201,6 +3198,8 @@ wreis: Wallace Reis <wallace@reis.org.br>
 
 Yuval Kogman, C<nothingmuch@woobling.org>
 
+rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
+
 =head1 LICENSE
 
 This library is free software. You can redistribute it and/or modify it under
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use lib "$FindBin::Bin/../lib";
+use Test::More;
+use URI;
+
+use_ok('TestApp');
+
+my $request = Catalyst::Request->new( {
+                base => URI->new('http://127.0.0.1/foo')
+              } );
+my $dispatcher = TestApp->dispatcher;
+my $context = TestApp->new( {
+                request => $request,
+                namespace => 'yada',
+              } );
+
+is(        $context->hello_lazy,    'hello there', '$context->hello_lazy');
+eval { is( $context->hello_notlazy, 'hello there', '$context->hello_notlazy') };
+TODO: {
+   local $TODO = 'we appear to have a lazy bug';
+   if ($@) {
+      fail('$context->hello_notlazy');
+      warn $@;
+   }
+}
+
+done_testing;
+
@@ -86,8 +86,20 @@ use Catalyst::Engine::CGI;
     is ''.$r->base, 'http://www.foo.com/oslobilder/', 'base correct';
 }
 
+# CGI hit on IIS for non / based app
+{
+    my $r = get_req(0,
+        SERVER_SOFTWARE => 'Microsoft-IIS/6.0',
+        PATH_INFO => '/bobtfish/Gitalist/script/gitalist.cgi/static/css/blueprint/screen.css',
+        SCRIPT_NAME => '/bobtfish/Gitalist/script/gitalist.cgi',
+        PATH_TRANSLATED =>
+'C:\\Inetpub\\vhosts\\foo.com\\httpdocs\\bobtfish\\Gitalist\\script\\gitalist.cgi\\static\\css\\blueprint\\screen.css',
+    );
+    is ''.$r->uri, 'http://www.foo.com/bobtfish/Gitalist/script/gitalist.cgi/static/css/blueprint/screen.css';
+    is ''.$r->base, 'http://www.foo.com/bobtfish/Gitalist/script/gitalist.cgi/';
+}
+
 {
-    local $TODO = 'Another mod_rewrite case';
     my $r = get_req (0,
         PATH_INFO => '/auth/login',
         SCRIPT_NAME => '/tx',
@@ -113,7 +125,6 @@ use Catalyst::Engine::CGI;
     is $r->base, 'http://www.foo.com/', 'Base is correct';
 }
 
-
 # FIXME - Test proxy logic
 #       - Test query string
 #       - Test non standard port numbers
@@ -0,0 +1,16 @@
+package TestApp::Controller::Moose::NoAttributes;
+use Moose;
+extends qw/Catalyst::Controller/;
+
+__PACKAGE__->config(
+   actions => {
+       test => { Local => undef }
+   }
+);
+
+sub test {
+}
+
+no Moose;
+1;
+
@@ -16,10 +16,39 @@ use Catalyst::Utils;
 use Moose;
 use namespace::autoclean;
 
+# -----------
+# t/aggregate/unit_core_ctx_attr.t pukes until lazy is true
+package Greeting;
+use Moose;
+sub hello_notlazy { 'hello there' }
+sub hello_lazy    { 'hello there' }
+
+package TestApp;
+has 'my_greeting_obj_notlazy' => (
+   is      => 'ro',
+   isa     => 'Greeting',
+   default => sub { Greeting->new() },
+   handles => [ qw( hello_notlazy ) ],
+   lazy    => 0,
+);
+has 'my_greeting_obj_lazy' => (
+   is      => 'ro',
+   isa     => 'Greeting',
+   default => sub { Greeting->new() },
+   handles => [ qw( hello_lazy ) ],
+   lazy    => 1,
+);
+# -----------
+
 our $VERSION = '0.01';
 
 TestApp->config( name => 'TestApp', root => '/some/dir', use_request_uri_for_path => 1 );
 
+# Test bug found when re-adjusting the metaclass compat code in Moose
+# in 292360. Test added to Moose in 4b760d6, but leave this attribute
+# above ->setup so we have some generated methods to be double sure.
+has an_attribute_before_we_change_base_classes => ( is => 'ro');
+
 if ($::setup_leakchecker && eval { Class::MOP::load_class('CatalystX::LeakChecker'); 1 }) {
     with 'CatalystX::LeakChecker';
 
@@ -0,0 +1,30 @@
+use strict;
+use Test::More;
+
+{
+    package NoAttributes::CT;
+    use Moose;
+    BEGIN { extends qw/Catalyst::Controller/; };
+
+    sub test {}
+}
+{
+    package NoAttributes::RT;
+    use Moose;
+    extends qw/Catalyst::Controller/;
+
+    sub test {}
+}
+
+foreach my $class (qw/ CT RT /) {
+    my $class_name = 'NoAttributes::' . $class;
+    my $meta = $class_name->meta;
+    my $meth = $meta->find_method_by_name('test');
+    {
+        local $TODO = "Known MX::MethodAttributes issue";
+        ok $meth->can('attributes'), 'method metaclass has ->attributes method for ' . $class;;
+    }
+}
+
+done_testing;
+